COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C  THIS PROGRAM CREATES FUNCTIONS FOR THE MUSIC PROGRAM USING 
C00020 ENDMK
C⊗;
C  THIS PROGRAM CREATES FUNCTIONS FOR THE MUSIC PROGRAM USING 
C  'SEG' OR 'SYNTH'.  UP TO 10 FUNCTIONS CAN BE STORED IN A
C  SINGLE FILE.  ONCE CREATED, THE FUNCTIONS MAY BE CHANGED
C  AND PUT BACK IN THE SAME FILE OR INTO A NEW ONE.
C  NO MORE THAN 50 INPUTS FOR ONE FUNCTION!
C TYPE 'C'(= CRUNCH)  FOR SPECIAL FEATURE SUBR TO COMBINE FUNCS 
C ALREADY MADE.      [MULT, ADD, RETRO, INVRT, ADD CONSTANT ]

C  SEG FUNCS MAY BE 'SMOOTHED' BUT THIS FEATURE AND 'CRUNCH' SHOULD 
C  BE USED SPARINGLY AS ALL 512 WDS OF THE ARRAY MUST BE SAVED.  THIS
C  CLUTTERS UP THE DSK.

C  'Z' FOR "CHANGE OR FINISH?" WILL JUMP DIRECTLY TO "CRUNCH" MODE.
C    BUT ONCE CHANGED BY 'CRUNCH' THIS UNSTORED ORIG. IS LOST.
C  'SP' (FOR "SEE") WILL PLOT ONE AT A TIME.
C  'SA' PLOTS ALL IN .FUN FILE ON CALCOMP
C  'SX' PLOTS ALL IN XGP FORMAT. (1ST→ <CTRL C>, A DSK PTP  --
C -- WHEN DONE→ <CTRL C>, F )  THEN USE "X" PROG. TYPE 6,11,1.

C FOR EXPONENTIALS GET INTO 'SEG'.  TYPE 'X', DECAY FAC, N.  IF 
C  N IS NON-ZERO THE FUNCTION WILL NOT! NORMALIZE (IE. NOT GO TO 0).
C  THE DECAY FAC. IS THE NUM ALONGTHE SCALE(1-100) WHERE THE CURVE
C  SEEMS TO TOUCH ZERO. (WILL ALWAYS HIT 0 AT END UNLESS N.NE.0.)

C AFTER FILE IS READ IN, <CR> FOR 'TYPE FILE' WILL HOLD ON TO IT.
C  LOAD WITH -- WRIFUN,FUSUB,DFUNC,SSS,MSFAIL.FAI (+RANFIL.MAC?)
	COMMON/S/H,AMP,CON,PH /GRD/ON
	COMMON/RD/ A(50,4),B(2,10),FN(10),XA(10),AA(4,178,10)
	1,LX,JX,JT,IDEL,FNUM,FNUM1,Z,FLNM,FLNM1,KT
	COMMON FUNC(512),F2(512),K,I
	DIMENSION RF(4)
21	FORMAT(' C=CHANGE, F=FINISH  '$)
22	FORMAT(' NEW FUNC, EDIT, CRUNCH, DELETE, RENAME, SEE?   '$)
23	FORMAT(' SEG OR SYNTH?   '$)
25	FORMAT(' TYPE FILE NAME   '$)
26	FORMAT(I3,') TYPE AMPL, STEP# -- OR L=LTPEN   '$)
C  'X' HERE WILL MAKE EXPON. FUNC.
28	FORMAT(' 0=NORM,OR H,A,P,K   '$)
280	FORMAT(' NEW VERSION!  --REPORT ANY PROBLEMS TO LCS'/
	1' UP TO 10 FUNCTIONS MAY BE STORED IN EACH FILE'/
	1' TYPE "B" TO BACKUP AT ANY TIME'//)
30	FORMAT(8F)
31	FORMAT(1XA5,A1,5A5/)
35	FORMAT(1XA5,'IN FILE "',A5,'.FUN"'/)
37	FORMAT(8F9.3)
371	FORMAT(I3,') ',4F8.2)
372	FORMAT(I,21F)
38	FORMAT(2(A5,A1),23A2)
40	FORMAT(11(A1,A3))
41	FORMAT(' ADD TO AN EXISTING FILE?   '$)
42	FORMAT(' WHICH FUNC?   '$)
47	FORMAT(' <CR>=EXIT,   C=CHNG (LN#, CHNGS),'/' I=INSRT,  
	1D=DEL (LN#) '$)
48	FORMAT(' X,N(=DECAY FAC.) FOR XPONTLS')
2281	TYPE 280
281	KZ=0
C   USED IN RELATIVE VECTOR ROUTINE
	Z=0
	XZ=0
	EY=0
	ICUR=0
	XP=0
	KT=0
	FNUM=0
	OLD=0
	FNUM1=0
	TYPE 22
	ACCEPT 40,ON,P
	PLTALL=0
C75	IF(P.EQ.'A'.OR.P.EQ.'X')PLTALL=-1
	IF(P.EQ.'A')GO TO 3280
	IF(P.NE.'X')GO TO 1281
3280	PLTALL=-1
1281	IPLOT=0
	XDPY=-1
	IF(ON.EQ.'N')GO TO 1000
	IF(ON.EQ.'E')GO TO 100
	IF(ON.EQ.'R')GO TO 100
	IF(ON.EQ.'D')GO TO 100
	IF(ON.EQ.'C')GO TO 100
	IF(ON.EQ.'S')GO TO 100
CC 7/74 COLGATE	ON=ONX
C ---OUT 7/74---  RETURNS FOR MORE "SEE"
CC 7/74 COLGATE	GO TO 4281
	GO TO 281
C  WON'T GO ON IF BLANK
C75	IF(ON.EQ.'N'.OR.(ON.EQ.' '.AND.ONX.NE.'S'))GO TO 1000
C75	IF(ON.NE.' ')GO TO 100
C75	ON=ONX
	XDPY=0
C  <CR> FOR 'SEE' WILL DISPLAY UP TO 3 FUNCS AT ONCE.
C  RETURNS FOR MORE "SEE"
C75	GO TO 4281
100	ONX=ON
	TYPE 25
	OLD=-1
	ACCEPT 38,FLNM1
	IF(FLNM1.EQ.' ')FLNM1=FLNM
	IF(FLNM1.EQ.0)GO TO 100
	IF(LOOKF(FLNM1).EQ.0)GO TO 100
	IF(FLNM.NE.FLNM1)GO TO 2151
	OLD=0
4281	TYPE 40,B
	IF(PLTALL)GO TO 5402
	GO TO 1402
2151	FLNM=FLNM1
	CALL READ1
3402	LX=0
	TYPE 40,B
	IF(PLTALL)GO TO 402
C  "SA" WILL PLOT ALL FUNCS IN FILE
	JX=-1
	IF(B(1,2).NE.' ')GO TO 1402
	FNUM1=B(2,1)
C  ONLY ONE FUNC IN FILE.
	GO TO 402
1402	TYPE 42
	ACCEPT 40,BU
	IF(BU.EQ.' ')GO TO 1402
	IF(BU.NE.'B')GO TO 380
	FLNM=0
	JX=0
	GO TO 281
380	REREAD 38,FNUM1
	IDEL=0
C  LX IS MAIN COUNTER
	IF(OLD)GO TO 402
	DO 1302 JX=1,10
1302	IF(FNUM1.EQ.FN(JX))GO TO 5402
C75	GO TO 3402
	GO TO 100
402	CALL READER
	IF(JX)GO TO 100
C 6/74  GO BACK IF IT DIDN'T FIND THE FUNC NAME IN THIS FILE.
C  AT THIS POINT LX=TOTAL FUNCS+1
5402	IF(PLTALL)JX=1
1202	IF(ON.EQ.'C')GO TO 3202
	IF(ON.EQ.'S')GO TO 3202
	IF(ON.NE.'D')GO TO 3281
3202	IF(XDPY)CALL DPYX(1)
	CALL DPYF(JX,FUNC)
	IF(PLTALL)GO TO 2202
	IF(P.EQ.'P')GO TO 2202
	IF(P.EQ.0)GO TO 2202
	IF(ON.EQ.'S')GO TO 2281
	IF(ON.EQ.'C')GO TO 1201
1140	TYPE 1139
	ACCEPT 40,IDEL
	IF(IDEL.EQ.'N')GO TO 2281
	IF(IDEL.NE.'Y')GO TO 1140
	IDEL=JX
	LX=LX-1
C  NOW LX=TOTAL # OF FUNCS.
	CALL WRIFUN
1139	FORMAT(' DELETE IT? ',$)
2202	CALL PLOTIT(FUNC,XA(JX),P)
	IF(P.EQ.'P')GO TO 2281
	JX=JX+1
	FNUM1=B(2,JX)
C75	IF(FNUM1.EQ.' ')GO TO 2281
	IF(FNUM1.EQ.' ')GO TO 4202
	IF(JX.LE.10)GO TO 1202
C  "SA" KEEPS PLOTTING UNTIL NO MORE ARE FOUND
C75	GO TO 2281
4202	CALL DDCLR
	CALL EXIT
3281	X=' '
	TYPE 31,XA(JX),X,FN(JX)
	JT=4
	IF(XA(JX).EQ.'SEG')JT=2
	KZ=1
	DO 137	K=1,50
	KZ=KZ+1
	DO 138 L=1,JT
138	A(K,L)=AA(L,K,JX)
	IF(A(K,1).EQ.999)GO TO 4401
137	IF(A(K,2).GE.100)GO TO 4401

4401	Z=-1
	IF(A(K,2).LE.100)GO TO 4403
	IF(K.GT.1)GO TO 4404
	CALL DPYX(1)
	CALL DPYF(JX,FUNC)
	IF(ON.EQ.'R')GO TO 3032
	TYPE 4405
	A(1,2)=520
	GO TO 4201
4404	TYPE 4402
4403	IF(JT.EQ.2)EY='EG'
	GO TO 1032
4402	FORMAT('  IT WAS SMOOTHED.')
4405	FORMAT(' CANNOT EDIT CRUNCHED FUNCS.'/)
1000	TYPE 23
	ACCEPT 40,BU
	IF(BU.EQ.'B')GO TO 281
	REREAD 40,X,EY
1032	CALL ZERO(FUNC)
C  CLEARS THE FUNC.
	ISMOO=0
	IF(EY.EQ.'EG')GO TO 800
151	EY=0
	JT=4
C  FOR WRIFUN
1031	CALL DPYX(1)
15	KT=1
104	IF(Z.EQ.-1)GO TO 102
	IF(KT.LT.KZ)GO TO 102
	IF(Z.EQ.1)GO TO 2032
1041	KZ=0
	TYPE 28
	Z=0
	ACCEPT 40,BU
	IF(BU.EQ.'B')GO TO 509
	REREAD 30,(A(KT,K),K=1,4)
C ACCEPT HARM,AMPL,PHASE,KONSTANT(IF K>100, MULTIPLIES WAVE *(K-100))
102	H=A(KT,1)
	IF(H.EQ.0)GO TO 2200
	IF(H.EQ.999.)GO TO 2200
C   999 ENDS 'READIN' SYNTHS
	IF(Z.GT.0)TYPE 371,KT,(A(KT,K),K=1,4)
	AMP=A(KT,2)
	PH=A(KT,3)
	CON=A(KT,4)
	CALL SYN(FUNC)
	KT=KT+1
	IF(KZ.LE.KT)CALL DPY(FUNC,1)
	GO TO 104
2201	IF(JT.NE.2)GO TO 1201
	IF(A(KT-1,2).GT.100)GO TO 1201
C  TO USE CURRENT FUNC IN CRUNCH
	IF(LX.GT.10)GO TO 204
	CALL STORE(10)
C  PUTS FROM A ARRAY TO AA ARRAY
	XA(K)='SEG'
	CALL DPYX(1)
	CALL DPYF(10,FUNC)
1201	CALL ZFUNC
C  THIS WILL BE FOR SPECIAL FEATURE PACKAGE
	IF(KT.EQ.512)GO TO 2281
C  FOR BACKUP
4201	EY='EG'
	KT=2
	GO TO 900
 2200	CALL NORM(FUNC)
C   NORMALIZES THE FUNCTION
	CALL DPY(FUNC,1)
 201	IF(BU.EQ.'C')GO TO 2032
	IF(ON.EQ.'R')GO TO 3032
204	TYPE 21
	IF(EY.EQ.'EG')TYPE 271
C   CHANGE IT?
	ACCEPT 40,BU
	IF(BU.EQ.'C')GO TO 210
	IF(BU.EQ.'F')GO TO 900
	IF(BU.EQ.'S')GO TO 7000
	IF(BU.EQ.'Z')GO TO 2201
C  TO USE CURRENT FUNC IN CRUNCH
	IF(BU.NE.'B')GO TO 2032
	IF(EY.EQ.'EG')GO TO 509
	GO TO 5091
C   NEXT IS FOR CHANGES ('C' OR <CR>)
2032	TYPE 47
	ACCEPT 40,K
	REREAD 372,L,X,RF
	IF(X.NE.0)GO TO 211
	IF(RF(1).NE.0)GO TO 211
	IF(EY.EQ.'EG')GO TO 204
	BU=0
	GO TO 1041
211	L=X
	IF(K.EQ.'I')GO TO 212
	IF(K.NE.'D')GO TO 205
C   JUMP IF NO DELETE
	KT=KT-1
	DO 209 K=L,KT
	DO 209 J=1,4
209	A(K,J)=A(K+1,J)
	GO TO 210
205	X=RF(2)
	IF(EY.NE.'EG')GO TO 1207
	IF(X.NE.0)GO TO 1205
	X=A(L,2)
	RF(2)=X
C TYPE JUST AMPL. TO CHANGE IT ONLY. (STEP 0 =SAME STEP AS BEFORE.)
1205	IF(X.LT.A(L+1,2))GO TO 208
	IF(L.LT.KT-1)GO TO 2032
	GO TO 208
212	L=1
	H=X
	IF(EY.NE.'EG')GO TO 4212
	L=L+1
	H=RF(1)
4212	DO 1212 K=1,KT
1212	IF(H.GE.A(K,L))GO TO 2212
C NOW WE KNOW WHERE TO MAKE THE INSERT
2212	DO 3212 L=KT+1,2,-1
3212	RF(L)=RF(L-1)
CC212	IF(RF(2).NE.0)GO TO 213
	RF(2)=RF(1)
	RF(1)=X
	L=KT
213	IF(EY.NE.'EG')GO TO 214
	X=RF(2)
	DO 215 K=1,KT
	Y=A(K,2)
	IF(X.GT.Y)GO TO 215
C   JUMP IF NOT PAST STEP NUM.
	L=K
	IF(X.EQ.Y)GO TO 208
C   IF STEP=ANOTHER STEP, IT WORKS LIKE 'C'HANGE.
	GO TO 214
215	CONTINUE
214	KT=KT+1
	DO 206 K=KT,L,-1
	DO 206 J=1,4
206	A(K,J)=A(K-1,J)
	GO TO 207
C   TO TYPE OLD NUMBERS
208	IF(X.GT.A(L-1,2))GO TO 1207
	IF(L.GT.1)GO TO 2032
1207	TYPE 371,L,(A(L,K),K=1,4)
207	DO 202 K=1,4
202	A(L,K)=RF(K)
210	KZ=KT
	Z=1
	GO TO 1032
271	FORMAT('+S=SMOOTH  '$)
C  FOR RENAMES
3032	Z=-1
	GO TO 901
900	TYPE 41
C  ADD TO EXISTING FILE
	ISKP=0
	ACCEPT 40,Z
9000	IF(Z.EQ.'B')GO TO 204
	IF(Z.EQ.'Y')GO TO 9001
	IF(Z.NE.'N')GO TO 900
9001	TYPE 25
	ACCEPT 38,FLNM
	IF(FLNM.NE.' ')GO TO 9002
	IF(FLNM1.NE.' ')FLNM=FLNM1
9002	IF(FLNM.EQ.'B')GO TO 204
	IF(FLNM.EQ.' ')GO TO 204
CC	IF(LOOKF(FLNM).AND.Z.EQ.'N')GO TO 902
	IF(LOOKF(FLNM))GO TO 902
	IF(Z.NE.'N')GO TO 900
C  LOOKF CHECKS ON LOOK-UP  FOR NAME.FUN
901	JT=4
	IF(EY.EQ.'EG')JT=2
	IDEL=0
	CALL WRIFUN
	GO TO 900
C  COMES BACK IF NO ROOM IN FILE FOR NEW FUNC.
902	IF(Z.NE.'N')GO TO 901
	TYPE 381,FLNM
	ACCEPT 40,Z
C75	IF(Z.NE.'N')GO TO 901
C75	GO TO 9000
C75 381	FORMAT(' WRITE OVER ',A5,'.FUN?  ',$)
	IF(Z.EQ.'Y')GO TO 903
	GO TO 9000
903	Z='N'
	GO TO 901
C  7/74 COLGATE  NOW WILL REALLY WRITE OVER A FILE!
381	FORMAT(/9X'WRITE OVER ',A5,'.FUN?  ',$)

161	DO 261 K=1,512
261	FUNC(K)=EXP((1-K)/STEP)
	KT=2
	XP=-1
	IF(H.NE.0)GO TO 7009
C  H≠0 = NO NORMALIZATION OF XPONTL
	X=FUNC(512)
	DO 361 K=1,512
361	FUNC(K)=FUNC(K)-(K-1)/511.*X
	GO TO 7009
800	IF(XP)GO TO 510
	X=0
	JT=2
C  JT AND EY SEEM TO PERFORM THE SAME FUNCTIONS??
	Y=0
	KT=1
	N=-256
	CALL DPYX(2)
	CALL DPYBRT(5)
504	IF(KT.GE.KZ)GO TO 510
	AMP=A(KT,1)
5008	STEP=A(KT,2)
	IF(STEP.GT.A(KT-1,2))GO TO 5071
	IF(KT.GT.1)GO TO 509
C   SO IT CAN'T GO BACKWARDS
	GO TO 5071
434	ICUR=0
	CALL CLRCUR
	GO TO 510
C   EXIT FROM CURSOR
CC431	CALL SETCUR(-256,128,0)
431	NX=-256
	NY=128
	NZ=0
C  TYPE <CR> HERE TO SET FIRST POINT AT 0,0
	ICUR8
ZD~∀hfL∪πβ→0A')
+$Q≥`Y≥2Y94R~∀%≥4zb4∃ε@@tbA)≡↓	%β∞↓↓→∨≥≤A-πQ∨$~∀%)3!
hfdY-(~∀∪¬ππ!P@h`Y¬∧~∀∪%Qβ∧9"\OλNS∂≡↓)≡@`+↓d4(LJ→"ε∩r⊗E9=⊃≥&≡zαR=↓#→P4(Ljav:@h(&6Kj:d4PJ∞ε2bαJ∩∞-⊃":adre$4T~&∞b1αN-"∞VIDra2:↓∃C
HQ!∃≥$Z∂%	V
lFV↓∀WZK_YεEα`fh≡J',VXL≤∀WY
Zα.
	IF(KT.EQ.1)STEP=1.
	IF(STEP9→(\b@`S∂≡↓)≡@jTnb~∀%β≠ z Q')@Zb``$↑Q')∃ [αQ-(ZbXHRRRT!αQ↔(4bXbR5β≠ R-β≠ ~(∪∪π+Hz`~∀%πβ→_↓π→%πU$~∀∪M) zD``\~(jjnb%)3!
fnYβ5 Y')∃ ~∀∪≥≡A)≡j`nb4∀lbb%
∨%≠¬(PNA9≡A≠∨I
A)⊃¬≤@j`↓'∂&≤↑R~∀Xb`∪)e!
@lDb~∀j@r∪↔(u↔(Zb4∃πε∪%Q∪πU$Sπβ1_A'Qπ+$Q50Y≠ JaE$4S)AeDLJ→"."r2Q9
J≡=α$y↓Iaλh(&≡zαR=↓∪	@4)#→H&~⎇∩6εQDIM1≥J↓r∞IsjN⊗≥bα	v
~.VAbαIvJ-"VJ9α↓≥=$hQUE@LJ→"&≥*I&≡zαR=↓#→L4(LJ→"."r⊗E9
JRfB*↓Q`4PJRfB*↓IY2] 4(&]Qu@4PJε∞∞-αQ↓Qαb
T4PJ&→"∃):⊗Er:	≥&<yαR=β)Ad4PJ&→"∃):⊗Er:1≥&<yαR=β!MD4S1D&J-∩⊗ε⊃β→A2εm↓2NR-↓2 4PJ&→"≥"⊗A:e!9E&≥"⊗Auλh(&&2B
U:-	9≡a:J≡=α$y↓EYλh*
↓¬"fB∃α:a≥α4zIα⊗Eα>99∧2V:
r↓-α∩,~εeα4
∞R>∩a↓-Eβiα:=∧r>J5ph*
↓¬:∃αN$
JQα<JR!α≥"⊗A↓
↓":>"↓A$4S)A]DLJ→"."r≡Q9+↓&≡=¬"=↓Y4*
α↓αR>zα6ε:JαN⊗≡_h(&&2Bi:≡"qA&RMα∃↓M;	2.Qd
6A2≥"⊗@4PJ&→"≥"⊗A:=!9EAαJNR⊗βiEA@hP&∩&3jε6AmH4(&L1"NR-↓6a:=!9A&<yαR=βIAALhP&&→DZQ::*qE&≡zαR=↓+↓P4*~↓↓αNzα&Qα≤
9≡Q∧∩ε∞.-↓α"⊗∀(4)eβ↓L&&2BNR⊗αr2∃9
q&evj@4)∪↓L&f≥"AvN$*@4(LJ→"f≥"A:≡"qE&≡zαR=↓⊃AL4PJfNRβi@4(MAu5DhQEIA_J**amA)U9⊃A5I+04(&uAvfN%↓)U9⊃A5I+04(&uIvε6αQIUYrYEIaph(&&Sje)I+19-E∪A84(L~ε21∧
2&:*B**adJi2:Bb:e$hP&∞εdaα∩BLzVQ!
H4)E⊂Jevεm4(&CjfNRh(&&2B.Q:=!9E&<yαR=β!AP4PJ&→"≥"⊗A:d)9E&<yαR=β!AP4T→↓αB-"M↓Ac↓α&9∧J→↓F≥!αNR-↓α&M∧r>Q↓
α>I↓h(&¬C	1E%k4(&
AE1IKi@4(LZQuHhQQAPL	".Qc	%vdhR∞&
B.Q1∩Iv`4PJ¬"."aI%v≥"⊗@4S9AADLZQv."YD4*~↓↓α."α∞>Vu"MαN,:6⊗:%_4(&L1"NR-↓:2Qs	AA&<yαR=β)AP4PJ≡=α$y↓IAλh(4);↓A@&L1"&Nlz=&≡zαR=↓∪↓D4(LJ→"."r2∃9∪↓&≡=¬"=↓]β↓\4(M"fB∃β9AA`hP&≡=¬"=↓UβH4)]β↓`&~⎇∩6εQB9α:=∧j>J∃¬""ε9β⊃AαN,:Mα&rα∞VJ4*M≥=Hh)]Aβ8&∞εdaαNN~B¬2."iE2~,r
$4T→↓↓α%∩ε↑M∧:J&⊃β⊂4)↓;↓Ad&≤
21α%αe"~,r
1IHh(&¬DZQ5Ec⊃%uU∪4(&M~6>=jiD4*~↓αN=¬J>Uα≤
9≡Q∧~>6∃∧∩ε∞-β⊃αR&l*L4(L:=αRz↓IADhP&⊗: h(